Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/storebmp/storebmp.frm

Visual Basic Form | 1995-01-11 | 6.3 KB | 211 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Store and Display Pictures"
   ClientHeight    =   6165
   ClientLeft      =   2475
   ClientTop       =   2070
   ClientWidth     =   5055
   Height          =   6570
   Icon            =   STOREBMP.FRX:0000
   Left            =   2415
   LinkTopic       =   "Form1"
   ScaleHeight     =   6165
   ScaleWidth      =   5055
   Top             =   1725
   Width           =   5175
   Begin CommandButton Command3
      Caption         =   "Bye"
      Height          =   1095
      Left            =   4440
      TabIndex        =   4
      Top             =   4920
      Width           =   495
   End
   Begin TextBox Text1
      DataField       =   "PictureName"
      DataSource      =   "Data1"
      Height          =   285
      Left            =   120
      TabIndex        =   2
      Top             =   5640
      Width           =   2415
   End
   Begin CommandButton Command2
      Caption         =   "Delete Picture"
      Height          =   495
      Left            =   2760
      TabIndex        =   1
      Top             =   5520
      Width           =   1575
   End
   Begin CommandButton Command1
      Caption         =   "Load Picture"
      Height          =   495
      Left            =   2760
      TabIndex        =   0
      Top             =   4920
      Width           =   1575
   End
   Begin Data Data1
      Caption         =   "View Pictures"
      Connect         =   ""
      DatabaseName    =   "STOREBMP.MDB"
      Exclusive       =   0   'False
      Height          =   270
      Left            =   120
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   "PictureTable"
      Top             =   5040
      Width           =   2415
   End
   Begin CommonDialog OpenDialog
      CancelError     =   -1  'True
      DialogTitle     =   "Select Bitmap or Icon"
      Filter          =   "Pictures(*.bmp;*.ico)|*.bmp;*.ico"
      InitDir         =   "c:\windows"
      Left            =   120
      Top             =   120
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "File Name"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   5400
      Width           =   1815
   End
   Begin Image Image1
      BorderStyle     =   1  'Fixed Single
      Height          =   4695
      Left            =   120
      Stretch         =   -1  'True
      Top             =   120
      Width           =   4815
   End
Option Explicit
Dim PictureDB As Database
Dim PictureTB As Dynaset
Dim CurrentDir As String
Sub CenterForm (FormToCenter As Form)
    FormToCenter.Top = (Screen.Height - FormToCenter.Height) / 2
    FormToCenter.Left = (Screen.Width - FormToCenter.Width) / 2
End Sub
Sub Command1_Click ()
    Dim FileToLoad As String
    Dim ChunkSize As Integer
    Dim TotalSize As Long
    Dim NumberOfChunks As Long
    Dim Remainder As Integer
    Dim CurChunk As String
    Dim HoldName As String
    Dim SearchCriteria As String
    Dim i As Integer
    Screen.MousePointer = 11
    On Error GoTo ErrorHandler1
    OpenDialog.Action = 1
    FileToLoad = OpenDialog.Filetitle
    PictureTB.AddNew
    PictureTB("PictureName") = FileToLoad
    'Load picture data
    ChunkSize = 12000
    Open OpenDialog.Filename For Binary As #1
    TotalSize = LOF(1)
    NumberOfChunks = TotalSize \ ChunkSize
    Remainder = TotalSize Mod ChunkSize
    For i = 0 To NumberOfChunks
        If i = NumberOfChunks Then
            CurChunk = String$(Remainder, " ")
            Get #1, , CurChunk
            PictureTB("PictureData").AppendChunk (CurChunk)
            Exit For
        End If
        CurChunk = String$(ChunkSize, " ")
        Get #1, , CurChunk
        PictureTB("PictureData").AppendChunk (CurChunk)
    Next i
    PictureTB.Update
    Close #1
    HoldName = FileToLoad
    Data1.Refresh
    SearchCriteria = "PictureName = '" + HoldName + "'"
    Data1.Recordset.FindFirst SearchCriteria
    If Data1.Recordset.NoMatch Then
        Stop
    End If
    ChDir CurrentDir
    Screen.MousePointer = 0
ErrorHandler1:
If Err = 32755 Then
    ChDir CurrentDir
    Screen.MousePointer = 0
    Exit Sub
End If
End Sub
Sub Command2_Click ()
    Screen.MousePointer = 11
    If Data1.Recordset.RecordCount = 0 Then
        image1.Picture = LoadPicture("")
        Screen.MousePointer = 0
        Exit Sub
    End If
    Data1.Recordset.Delete
    Data1.Refresh
    If Data1.Recordset.RecordCount = 0 Then
        image1.Picture = LoadPicture("")
    End If
    Screen.MousePointer = 0
End Sub
Sub Command3_Click ()
    End
End Sub
Sub Data1_Reposition ()
    Dim Offset As Long
    Dim ChunkSize As Integer
    Dim TotalSize As Long
    Dim NumberOfChunks As Long
    Dim Remainder As Integer
    Dim CurChunk As String
    Dim i As Integer
    Dim x As String
    Screen.MousePointer = 11
    ChDir CurrentDir
    If PictureTB.RecordCount = 0 Or Data1.Recordset.RecordCount = 0 Then
        Screen.MousePointer = 0
        Exit Sub
    End If
    'Load picture data
    ChunkSize = 12000
    Open Data1.Recordset("PictureName") For Binary As #2
    TotalSize = Data1.Recordset("PictureData").FieldSize()
    NumberOfChunks = TotalSize \ ChunkSize
    Remainder = TotalSize Mod ChunkSize
    Offset = 0
    For i = 0 To NumberOfChunks
        If i = NumberOfChunks Then
            CurChunk = Data1.Recordset("PictureData").GetChunk(Offset, Remainder)
            Put #2, , CurChunk
            Exit For
        End If
        CurChunk = Data1.Recordset("PictureData").GetChunk(Offset, ChunkSize)
        Put #2, , CurChunk
        Offset = Offset + ChunkSize
    Next i
    Close #2
    image1.Picture = LoadPicture(Data1.Recordset("PictureName"))
    x = CurDir$
    Kill Data1.Recordset("PictureName")
    Screen.MousePointer = 0
End Sub
Sub Form_Load ()
    Set PictureDB = OpenDatabase("Storebmp.mdb")
    Set PictureTB = PictureDB.CreateDynaset("PictureTable")
    CurrentDir = CurDir$
    If Right(CurrentDir, 1) = "\" Then
        CurrentDir = Mid(CurrentDir, 1, Len(CurrentDir) - 1)
    End If
    Call CenterForm(Me)
End Sub